; _____ _ __ __ _
; | __ \ (_) \ \ / / | |
; | |__) |__ _ _ __ ___ _ _ __ __ _ \ \ /\ / /___ _ __ __| |___
; | ___// _` | '__/ __| | '_ \ / _` | \ \/ \/ // _ \| '__/ _` / __|
; | | | (_| | | \__ \ | | | | (_| | \ /\ /| (_) | | | (_| \__ \
; |_| \__,_|_| |___/_|_| |_|\__, | \/ \/ \___/|_| \__,_|___/
; __/ |
; |___/
; Dictionary lookup and associated parsing words
; WORD ( delimiter address -- address length )
;
; Moves through TIB in VDP memory, discarding leading delimiters,
; looking for a word. A word is identified when a trailing delimiter is
; detected. The identified word is copied from VDP to a buffer in CPU memory.
; Pushes the start address of the word (in CPU memory), and the length of
; the word to the stack. If no word is found (for example if we hit the
; end of the TIB without detecting a word then 0 0 is pushed on the
; stack.
_word mov *stack,r0 ; buffer address
a @in,r0 ; add offset
mov @2(stack),r2 ; delimeter
sla r2,8 ; move to high-byte
li r6,wrdbuf+1 ; address of cpu word buffer
mov r6,@2(stack) ; push it to stack
clr r8 ; length counter
mov @_span,r7 ; number of chars in buffer
jeq noword ; if 0 then there's no word
c @in,@_span ; hit end of buffer?
jhe noword ; if yes then exit
wrd1 bl @wrdgb ; read a character and advance along input
inc @in ; advance >IN
cb r1,r2 ; was the character a delimiter?
jeq wrd1 ; if yes then get another character
c @in,@_span ; hit end of buffer?
jgt wrdfin ; if yes then quit
wrd2 movb r1,*r6+ ; move character to word buffer
inc r8 ; increment length
c r8,@tibsiz ; have we fully populated the word buffer?
jeq wrdfin ; if yes then exit
bl @wrdgb ; read a character and advance along input
inc @in ; advance >in
c @in,@_span ; hit end of buffer?
jgt wrdfin ; if yes then quit
cb r1,r2 ; was the character a delimeter?
jne wrd2 ; if not then get another character
wrdfin mov r8,*stack ; push length to stack
jmp wrdxit1 ; exit
noword clr *stack ; no word found, push 0 length
clr @2(stack) ; zero address
clr r8
wrdxit1 swpb r8 ; populate length byte (for packed string)
movb r8,@wrdbuf
wrdxit2 b @retB0
wrdgb mov @source,r15 ; check source
jeq vread ; if 0 then read from vdp
; special case: if EVALUATE is active then the evaluation string will be in
; CPU RAM
movb *r0+,r1 ; otherwise read from cpu and advance buffer
rt ; return to caller
vread mov r11,r14 ; save return address
vread1 bl @_vsbr ; read from vdp
vread2 inc r0 ; advance input buffer address
b *r14 ; return to caller
; code for processing \ type comments
; assembly equivalent of : \ >IN @ 64 + -64 AND >IN ! ; IMMEDIATE
_trcom mov @blknum,r0 ; loading a block?
jeq trcom1 ; jump if not
mov @in,r0
ai r0,64
andi r0,-64
mov r0,@in
jmp wrdxit2 ; exit (jump is smaller than a branch!)
trcom1 mov @tibsiz,@in ; set >IN to the end of the line
comxit jmp wrdxit2 ; exit (jump is smaller than a branch!)
; NUMBER ( address length -- (numberMSW) numberLSW error )
; Attempts to convert the string at cpu address address into a number.
; If fully successful, the number is placed on the stack and flag will be 0.
; If it fails (for example contains an illegal character) then a partial number
; will be placed on the stack (the value computed up until the failure) and
; flag will be -1. This allows neat trapping with ABORT""
; Thus, if flag<>0 the string failed to parse fully as a number.
; A minus sign is permitted for negative numbers.
; This routine uses BASE to parse numbers in the current BASE.
; Eg. If BASE=16 then digits 0-9 and A-F are considered legal and will be
; parsed properly.
; A facility also exists called 'quick hex' that allows a number to be entered
; in base 16, by placing a $ symbol at the beginning of the string. This avoids
; the need to change BASE to enter a number. E.g. instead of HEX FEED DECIMAL
; you can simply do $FEED. The number will be parsed as a HEX number without the
; need to change BASE.
; The same facility also exists for binary numbers: use a % symbol.
; E.g. %1001 = 9 decimal
; The numbers returned are (by default) singles (16 bits). NUMBER can can also
; return a double (32-bit (2 stack cells)) value by including a period in the
; number string. E.g. 100. 1.00 10.0 .100 will all return 100 decimal as a
; double.
; The various facilities can be mixed. For example, -$.F means -15 as a double.
_numbr mov *stack+,r1 ; pop length
mov *stack,r0 ; get address from stack
; parse the number string...
parsnm clr r6 ; initialise MSW
clr r8 ; initialise LSW
clr r13 ; clear negative flag
clr r12 ; clear 'double required' flag
seto @dpl ; assume single precision
; begin ugly hack - check the end of the number for a period character
; if found, set double indicator (R12) to on and reduce length of string
; by 1. Added for TF V1.1 double precision library support
mov r0,r15 ; copy string address
a r1,0 ; add length
dec r0 ; point to last character in the buffer
movb *r0+,r2 ; get character from buffer
srl r2,8 ; move it to low byte
ci r2,'.' ; is it a period character?
jne xugly ; if not then skip
seto r12 ; otherwise set the double flag to on
dec r1 ; and reduce the length for the string so
; that the period will not be seen by the
; number parser
seto @dpl ; double integer
; end ugly hack
xugly mov r15,r0
mov @base,r14 ; get base
dec r14 ; base-1=highest legal digital for base
num0 movb *r0+,r2 ; get character from buffer
srl r2,8 ; move it to low byte
num4 ci r2,'%' ; is it a % sign (binary)
jne num5
li r14,1 ; set binary base
jmp num3 ; do next character
num5 ci r2,'.' ; is it a dot?
jne num1 ; skip if not
; double detected - set r12 as flag, and calculate value for DPL
seto r12 ; else double is required - set flag
mov @2(stack),r15 ; get string length
mov r15,r7 ;
s r1,r7 ; subtract current position from length
s r7,r15 ; get length to the right of the dec. point
dec r15 ; correcty length due to decimal point
mov r15,@dpl ; store in DPL
jmp num3 ; do next character
num1 ci r2,'$' ; is it a dollar sign?
jne num2 ; skip if not
li r14,15 ; force base temporarily to 16-1 for hex
jmp num3 ; check next character
num2 ci r2,'-' ; is it a negative sign?
jne numlz ; skip if not
seto r13 ; else set negative flag
num3 dec r1 ; decrement counter
jmp num0 ; get next character
; digit range checks...
numlz ci r2,'0' ; check if ascii code < "0"
jl ohshit ; error if yes
ci r2,'z' ; check if ascii code > "z"
jh ohshit ; error if yes
; check if is numeric digit
ci r2,'9'
jle numisd ; it IS a digit
; check if is upper case digit
ci r2,'A'
jhe numt1
jmp ohshit
numt1 ci r2,'Z'
jle numisl ;
; check if is lower case digit
ci r2,'a'
jhe numt2
jmp ohshit
numt2 ci r2,'z'
jhe ohshit
ai r2,-87 ; convert to number
jmp numgo
; illegal digit
ohshit seto r0 ; else illegal digit was detected
jmp nexit ; indicate error
numisl ai r2,-55 ; convert from upper case to number
; ("A" (65) becomes 10)
jmp numgo ; start the conversion
numisd ai r2,-48 ; convert from ascii to decimal
; ("0" (48) becomes 0)
; parse the string into a 32 bit number...
numgo c r2,r14 ; compare to base
jh ohshit ; if digit outside current base's legal
; range then exit
a r2,r8 ; add digit to LSW
dec r1 ; finished?
jeq numend ; jump if yes
mov r14,r2 ; base-1 to r2
inc r2 ; correct to base
mov r8,r7 ; get our lsw in r7
mpy r2,r7